home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / basic / topmenu2.zip / TOPMENU2.BAS < prev    next >
BASIC Source File  |  1989-09-06  |  17KB  |  397 lines
  1.  
  2. SUB Top.Menu (sel, sel$(), fgc, bgc, hlc, topline, dis.time, dis.date, scn.blank, msg$, bgc$)
  3.  
  4. '========================================================================
  5. 'Initilize Routine Varables
  6. '========================================================================
  7.         DIM a(20)     ' maximum number of top selections allowed
  8.         month.data$ = "JanFebMarAprMayJunJulAugSepOctNovDec"
  9. start:  S$ = ""
  10.         a = 0
  11.       
  12. '========================================================================
  13. ' Clear The Screen Using The Character in bgc$
  14. ' Using The Colors Specified in fgc,bgc this will print the bgc$
  15. ' Character to all locations on the screen.
  16. '========================================================================
  17.         COLOR fgc, bgc
  18.         FOR i = 1 TO 25
  19.          LOCATE i, 1
  20.          PRINT STRING$(80, bgc$);
  21.         NEXT
  22.      
  23. '========================================================================
  24. 'Initilize Line# 25 (The Help Line)
  25. 'This will init the Help Line to reverse colors specified in fgc,bgc.
  26. '
  27. 'Line 25 is where the Help messages are displayed for the Selections
  28. '
  29. 'The Message Strings are passed via the SEL$(x,10) string of each selection
  30. '========================================================================
  31.        LOCATE 25, 1
  32.        COLOR bgc, fgc
  33.        PRINT SPACE$(80);
  34.        COLOR fgc, bgc
  35.  
  36. '========================================================================
  37. 'Read the Selection Names that where passed in array SEL$(x,0)
  38. 'Store the length of each one in the array A().
  39. 'Get the 1st character of each SEL$(x,0), and build a string of them,
  40. 'this string is used to make top row selections based on letters.
  41. 'Read them until SEL$(x,0) is a Nul (0) length.
  42. '========================================================================
  43.        i = -1
  44.        DO
  45.           i = i + 1
  46.           a(i) = LEN(sel$(i, 0))
  47.           z$ = LTRIM$(sel$(i, 0))
  48.           S$ = S$ + UCASE$(LEFT$(z$, 1))
  49.        LOOP WHILE sel$(i, 0) <> ""
  50.         
  51. '========================================================================
  52. ' Setup the SEL variable to the correct value based on the number of
  53. ' selections that are to be displayed in the menu.
  54. '========================================================================'
  55.         sel = i - 1
  56.    
  57. '========================================================================
  58. ' Print the Message thats in MSG$ on the top line of the menu.
  59. ' If no message (MSG$=""), then make top line a line
  60. ' else center the message in MSG$ on the top line.
  61. '========================================================================
  62.        LOCATE topline + 1, 3
  63.        COLOR fgc, bgc
  64.        t = INT((75 - LEN(msg$)) / 2)
  65.        IF t * 2 + LEN(msg$) < 75 THEN f$ = STRING$((75 - (t * 2 + LEN(msg$))), "─") ELSE f$ = ""
  66.        PRINT "┌" + STRING$(t, "─") + msg$ + f$ + STRING$(t, "─") + "┐";
  67.       
  68. '========================================================================
  69. 'Initilize 2nd line of Menu
  70. 'Print blank line as 2nd line
  71. 'then display Selection Names on line 2
  72. 'The names are in array SEL$(x,0)
  73. '========================================================================
  74.        LOCATE topline + 2, 2            'print blank line
  75.        COLOR 0, 0
  76.        PRINT " ";
  77.        COLOR fgc, bgc
  78.        PRINT "│" + SPACE$(75) + "│";
  79.        '-----------------------------------------------------------------
  80.        LOCATE topline + 2, 5            'print selection Names
  81.        COLOR fgc, bgc
  82.        FOR i = 0 TO sel
  83.          PRINT sel$(i, 0);
  84.        NEXT
  85.   
  86. '========================================================================
  87. 'Print 3rd line of Menu ( bottom of box)
  88. '========================================================================
  89.        LOCATE topline + 3, 2
  90.        COLOR 0, 0
  91.        PRINT " ";
  92.        COLOR fgc, bgc
  93.        PRINT "└" + STRING$(75, "─") + "┘";
  94.  
  95. '========================================================================
  96. ' Setup varables
  97. '========================================================================
  98.        subsel = 1
  99.        subnum = 1
  100.        zold = 2
  101.        S = 0
  102.        x = 5
  103. '========================================================================
  104. ' Display submenu for the new Selection Name of SEL number
  105. '========================================================================
  106.   GOSUB dis.sub
  107.  
  108. '========================================================================
  109. 'Display New Selection Name highlited on selection bar
  110. '========================================================================'
  111. lp:    oldx = x                         'update variables
  112.           x = 5
  113.        '-----------------------------------------------------------------
  114.        FOR i = 0 TO S                   'Calculate new Selection position
  115.          x = x + LEN(sel$(i, 0))
  116.        NEXT
  117.        '-----------------------------------------------------------------
  118.        x = x - LEN(sel$(i - 1, 0))      'fix  x  to equal location
  119.                                         'start of NEW selection Name
  120.        '-----------------------------------------------------------------
  121.        COLOR fgc, bgc                   'put OLD selection Name back to
  122.        LOCATE topline + 2, oldx         'original color
  123.        PRINT sel$(olds, 0);
  124.        '-----------------------------------------------------------------
  125.        COLOR hlc, fgc                   'Select NEW selection Name
  126.        LOCATE topline + 2, x            'with highlite color
  127.        PRINT sel$(S, 0);
  128.                                                      
  129. '========================================================================
  130. ' Print the message for the New Selection Name centered on line 25
  131. ' The string is taken from SEL$(x,10)
  132. ' Based on the current value of S.
  133. '========================================================================'
  134.        t = INT((80 - LEN(sel$(S, 10))) / 2)
  135.        IF t * 2 + LEN(sel$(S, 10)) < 78 THEN f$ = STRING$((78 - (t * 2 + LEN(sel$(S, 10)))), "─") ELSE f$ = ""
  136.        LOCATE 25, 1
  137.        COLOR bgc, fgc
  138.        PRINT SPACE$(t) + sel$(S, 10) + f$ + SPACE$(t);
  139.        COLOR fgc, bgc
  140.  
  141. '========================================================================'
  142. ' Wait for KEY to be pressed and....
  143. ' Display Current TIME if variable Dis.Time is not equal to 0.
  144. ' Display Current DATE if variable Dis.Date is not equal to 0.
  145. ' if screen blank is ON (scn.blank=1) then blank screen if no key is
  146. ' pressed for 3 minutes
  147. '========================================================================'
  148. get.key: blk.time = VAL(MID$(TIME$, 4, 2))
  149.  
  150.          DO
  151.            a$ = INKEY$
  152.        '-----------------------------------------------------------------
  153.          IF dis.date = 0 THEN GOTO dtime          'Display Date
  154.            month$ = MID$(month.data$, (((VAL(DATE$) - 1) * 3) + 1), 3)
  155.            LOCATE topline + 1, 4
  156.            PRINT CHR$(16) + month$ + " " + MID$(DATE$, 4, 2) + "," + MID$(DATE$, 9, 2) + CHR$(17)
  157.        '-----------------------------------------------------------------
  158. dtime:   IF dis.time = 0 THEN GOTO chk.blank      'Display Time
  159.            tx = VAL(LEFT$(TIME$, 2))
  160.            am$ = "Am"
  161.            IF tx > 12 THEN tx = tx - 12: am$ = "Pm"
  162.            t$ = CHR$(16) + RIGHT$(STR$(tx), 2) + ":" + MID$(TIME$, 4, 2) + " " + am$ + CHR$(17)
  163.           
  164.            LOCATE topline + 1, 69
  165.            PRINT t$
  166.        '-----------------------------------------------------------------
  167. chk.blank: IF scn.blank = 0 THEN GOTO key.loop    'blank screen
  168.            IF VAL(MID$(TIME$, 4, 2)) > blk.time + 2 THEN GOTO blk.scrn
  169.           
  170. key.loop: LOOP WHILE a$ = ""
  171.  
  172. '========================================================================'
  173. 'Process the key that was pressed
  174. '========================================================================''
  175.          IF LEN(a$) < 2 THEN GOTO reg.key       'if the key is an
  176.                                                 'extended key (len>1)
  177.                                                 'then process as cursor key
  178.                                                 'else check for othe